Unit OcTreeErr;

Interface

Uses
  Winapi.Windows,
  Winapi.Messages,
  System.SysUtils,
  System.Classes,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  Vcl.ExtCtrls,
  Vcl.ComCtrls,
  Vcl.Menus,
  Vcl.StdCtrls,
  Vcl.Buttons,
  GLS.Scene,
  GLS.VectorFileObjects,
  GLS.Objects,
  GLS.Texture,
  GLS.VectorGeometry,
  GLS.Skydome,
  GLS.Graph,
  GLS.Mesh,
  GLS.Cadencer,
  GLS.VectorTypes, GLS.HUDObjects,
  GLS.SceneViewer,
  GLS.State,
  GLS.File3DS,
  GLS.GeomObjects,
  GLS.Coordinates,
  GLS.BaseClasses;

Const

  CamDistDef = 10; // Default distance of the camera to the target object
  CamDistMax = 200; // MinMax values allowed when zooming
  CamDistMin = 1;
  CamFocalMax = 20000;
  // MinMax values allowed when changing camera focus. Default is 100
  CamFocalMin = 20;

  // Cursor ID's
  ZoomCursor = 5;
  MoveXYCursor = 6;
  MoveZCursor = 7;
  RotateCursor = 8;
  FocusCursor = 9;
  LightCursor = 10;

Type

  TViewerState = (vsRotate, vsZoom, vsPanXY, vsPanZ, vsFocus, vsLight);

  TMainForm = class(TForm)
    Scene: TGLScene;
    Viewer: TGLSceneViewer;
    DummyCube: TGLDummyCube;
    MainCam: TGLCamera;
    Light1: TGLLightSource;
    MainPanel: TPanel;
    Plane1: TGLPlane;
    FreeForm1: TGLFreeForm;
    Sphere1: TGLSphere;
    Sphere2: TGLSphere;
    Sphere3: TGLSphere;
    ArrowLine1: TGLArrowLine;
    ArrowLine2: TGLArrowLine;
    ArrowLine3: TGLArrowLine;
    DummyCube1: TGLDummyCube;
    TrackBar1: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    TrackBar2: TTrackBar;
    Label4: TLabel;
    TrackBar3: TTrackBar;
    Label5: TLabel;
    TrackBar4: TTrackBar;
    Label6: TLabel;
    procedure ViewerMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ViewerMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure ViewerMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure TrackBar1Change(Sender: TObject);
    procedure TrackBar2Change(Sender: TObject);
    procedure TrackBar3Change(Sender: TObject);
    procedure TrackBar4Change(Sender: TObject);
  Private
    // This tells what we should do when the user drags the mouse, based on the
    // keys that are down
    ViewerState: TViewerState;
    // Ratio of camera target distance to focal length. When changing focal length
    // keep the ratio constant so that the target object seems to stay at the same place
    // to the viewer
    CameraAspect: Double;
    // These track down the mouse events in the viewer
    MouseDown: Boolean;
    MouseX, MouseY: Integer;
    // The light follows the camera, we have to call this whenever the camera position changes
    Procedure ReAdjustLightPosition;
    // Resets the camera such that it's CamDistDef distance away from the target in the direction [X,Y,Z]
    // Magnitude of [X,Y,Z] is irrelevant
    Procedure ResetCamera(X, Y, Z: Double);
    // This proc handles changing the cursor as well as switching the ViewerState. Called from the form's
    // keydown and keyup events
    Procedure SetGLCursor(Var Key: Word; Down: Boolean);
  Public
  End;

Var
  MainForm: TMainForm;

Implementation

{$R *.DFM}
{$R CURSORS.RES}

{ ==============================================================================
  Check if a control (including all its parents) are visible
}
Function IsControlShowing(C: TControl): Boolean;
Begin
  Result := False;
  Try
    While Not(C is TForm) Do
      If Not C.Visible Then
        Exit
      Else
        C := C.Parent;
  Except
    On Exception Do;
  End;
  Result := True;
End;

{ ==============================================================================
  Returns true if a given screen coordinate (ie Mouse.CursorPos) is over a given
  component (which must be showing)
}
Function PointOver(T: TPoint; C: TControl): Boolean;
Var
  T1, T2: TPoint;
Begin
  T1.X := 0;
  T1.Y := 0;
  T2.X := C.Width;
  T2.Y := C.Height;
  T1 := C.ClientToScreen(T1);
  T2 := C.ClientToScreen(T2);
  Result := IsControlShowing(C) And (T.X >= T1.X) And (T.X <= T2.X) And
    (T.Y >= T1.Y) And (T.Y <= T2.Y);
End;

{ ==============================================================================
  The light follows the camera but at some distance away. We don't want the light
  too close to the target object when we zoom in.
}
Procedure TMainForm.ReAdjustLightPosition;
Begin
  Light1.Position.X := MainCam.Position.X * 20;
  Light1.Position.Y := MainCam.Position.Y * 20;
  Light1.Position.Z := MainCam.Position.Z * 20;
End;

{ ==============================================================================
  Remember mouse position when it was clicked down
}
Procedure TMainForm.ViewerMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Begin
  MouseDown := True;
  MouseX := X;
  MouseY := Y;
End;

{ ==============================================================================
  Main routine
}
Procedure TMainForm.ViewerMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
Var
  dx, dy: Integer;
  v: TGLVector;
  d: Double;
Begin
  If Not MouseDown Then
    Exit;

  // How much the mouse has moved since last time
  dx := MouseX - X;
  dy := MouseY - Y;

  Case ViewerState Of
    vsRotate:
      Begin
        // Rotate the camera around the target
        MainCam.MoveAroundTarget(dy, dx);
        ReAdjustLightPosition;
      End;
    vsZoom:
      Begin
        // 0.01 is an arbitrary scale factor
        // Notice we first check if the mouse movement will result in an allowable
        // camera target distance and if not, we clamp the value before assigning
        // it to camera.
        d := (1 - dy * 0.01) * MainCam.DistanceToTarget;
        If d > CamDistMax Then
          d := CamDistMax;
        If d < CamDistMin Then
          d := CamDistMin;
        MainCam.AdjustDistanceToTarget(d / MainCam.DistanceToTarget);
        // We also update the CameraAspect so that next time the focal length
        // changes, this new ratio is used
        CameraAspect := MainCam.DistanceToTarget / MainCam.FocalLength;
        // Again, lights follow the camera
        ReAdjustLightPosition;
      End;
    vsPanXY:
      Begin
        // Convert the delta movement to GLScene translation, correcting for the camera
        // target distance and the focal length
        v := MainCam.ScreenDeltaToVectorXY(dx, -dy,
          0.12 * MainCam.DistanceToTarget / MainCam.FocalLength);
        // Camera is actually a child of the dummycube (the target object). This separates
        // translation from rotation, the former applied to the dummycube (and thus indirectly to the
        // camera as well), the latter to the camera only. This way, instead of panning the scene,
        // we translate the dummycube+camera. Such motion has side effects too. For example, the proper
        // place to attach a skydome would be as a child of the dummycube.
        DummyCube.Position.Translate(v);
        ReAdjustLightPosition;
        MainCam.TransformationChanged;
      End;
    vsPanZ:
      Begin
        // Same deal as above except that the motion is limited to one axis
        v.X := 0;
        v.Y := 0;
        v.Z := -dy * 0.12 * MainCam.DistanceToTarget / MainCam.FocalLength;
        DummyCube.Position.Translate(v);
        ReAdjustLightPosition;
        MainCam.TransformationChanged;
      End;
    vsFocus:
      Begin
        // We first figure out what the new focal length would be
        d := (1 - dy * 0.01) * MainCam.FocalLength;
        // then clamp it down based on the constraints. Checking against CamDistMax/CameraAspect ..etc
        // at this stage makes sure we don't end up with an illegal DistanceToTarget for the camera
        // since to keep the target in the same virtual location, camera-target distance adjustment has
        // to immediately follow a focus adjustment
        If d > CamFocalMax Then
          d := CamFocalMax;
        If d > CamDistMax / CameraAspect Then
          d := CamDistMax / CameraAspect;
        If d < CamFocalMin Then
          d := CamFocalMin;
        If d < CamDistMin / CameraAspect Then
          d := CamDistMin / CameraAspect;
        MainCam.FocalLength := d;
        MainCam.AdjustDistanceToTarget(MainCam.FocalLength * CameraAspect /
          MainCam.DistanceToTarget);
      End;
    vsLight:
      Begin
        // Simply alter the light intensity. Notice this time the change is additive
        d := Light1.Diffuse.Red;
        d := d + dy * 0.001;
        If d > 1 Then
          d := 1
        Else If d < 0 Then
          d := 0;
        Light1.Diffuse.Red := d;
        Light1.Diffuse.Green := d;
        Light1.Diffuse.Blue := d;
      End
  End;

  // Reset the mouse position
  MouseX := X;
  MouseY := Y;

End;

{ ==============================================================================
}
Procedure TMainForm.ViewerMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
Begin
  MouseDown := False;
End;

{ ==============================================================================
  Position the camera in it's default location..etc
}
Procedure TMainForm.ResetCamera(X, Y, Z: Double);
Var
  d: Double;
Begin
  d := CamDistDef / Sqrt(Sqr(X) + Sqr(Y) + Sqr(Z));
  DummyCube.Position.X := 0;
  DummyCube.Position.Y := 0;
  DummyCube.Position.Z := 0;
  MainCam.Position.X := X * d;
  MainCam.Position.Y := Y * d;
  MainCam.Position.Z := Z * d;
  MainCam.FocalLength := 100;
  ReAdjustLightPosition;
  MainCam.TransformationChanged;
  CameraAspect := MainCam.DistanceToTarget / MainCam.FocalLength;
End;

{ ==============================================================================
  This proc is called from the form KeyDown events (Form.KeyPreview is set to true)
  and based on the key that went down/up.
}
Procedure TMainForm.SetGLCursor(Var Key: Word; Down: Boolean);
Var
  K: Integer;
  B: Boolean;
Begin
  B := PointOver(Mouse.CursorPos, Viewer);

  ViewerState := vsRotate;
  K := RotateCursor;

  If Down Then
  Begin
    Case Key Of
      VK_SHIFT:
        Begin
          ViewerState := vsZoom;
          K := ZoomCursor;
        End;
      VK_CONTROL:
        Begin
          ViewerState := vsPanXY;
          K := MoveXYCursor;
        End;
      VK_MENU:
        Begin
          ViewerState := vsPanZ;
          K := MoveZCursor;
        End;
      Ord('F'), Ord('f'):
        Begin
          ViewerState := vsFocus;
          K := FocusCursor;
        End;
      Ord('L'), Ord('l'):
        Begin
          ViewerState := vsLight;
          K := LightCursor;
        End;
      Ord('R'), Ord('r'):
        If B Then
          ResetCamera(1, 1, 1);
    End;
  End;

  If Viewer.Cursor <> K Then
  Begin
    Viewer.Cursor := K;
    // This next line is necessary to update the cursor immediately in the case
    // where a key switched state while a mouse button was being held down. To see
    // the problem, comment out the next line, then LEFT CLICK AND HOLD, then PRESS SHIFT :
    // the mouse cursor will not update.
    If B then
      SetCursor(Screen.Cursors[K]);
  End;
  // Since the ALT key has a special significance (brings up menu), we disable it
  // if pressed over the GLSceneViewer. Again, to see the problem, you can comment
  // out the next line and try pressing ALT: the cursor will reset to the default
  // one, depending on the timing
  If (Key = VK_MENU) And B Then
    Key := 0;

End;

{ ==============================================================================
}
Procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
Begin
  SetGLCursor(Key, True);
End;

{ ==============================================================================
}
Procedure TMainForm.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
Begin
  SetGLCursor(Key, False);
End;

{ ==============================================================================
}
Procedure TMainForm.FormCreate(Sender: TObject);
Var
  K: Word;
Begin
  // Load cursors
  Screen.Cursors[ZoomCursor] := LoadCursor(HInstance, 'ZoomCursor');
  Screen.Cursors[MoveXYCursor] := LoadCursor(HInstance, 'PanXYCursor');
  Screen.Cursors[MoveZCursor] := LoadCursor(HInstance, 'PanZCursor');
  Screen.Cursors[RotateCursor] := LoadCursor(HInstance, 'RotateCursor');
  Screen.Cursors[FocusCursor] := LoadCursor(HInstance, 'FocusCursor');
  Screen.Cursors[LightCursor] := LoadCursor(HInstance, 'LightCursor');
  // Reset the camera
  // ResetCamera(1,1,1);
  // Set the cursors and the ViewerState
  K := 0;
  SetGLCursor(K, False);

  // load freeforms
  // freeform1.LoadFromFile('rotella.3ds');
  FreeForm1.LoadFromFile('camma.3ds');
  FreeForm1.Material.PolygonMode := pmLines;
  FreeForm1.BuildOctree;
End;

{ ==============================================================================
}

procedure TMainForm.TrackBar1Change(Sender: TObject);
var
  RayStart, RayVector, iPoint, iNormal: TGLVector;
begin
  Sphere1.TurnAngle := TrackBar1.Position;
  if (FreeForm1.RayCastIntersect(Sphere1.Position.AsVector,
    Sphere1.Direction.AsVector, @iPoint, @iNormal)) then
  begin
    Sphere3.Position.AsVector := iPoint;
    Sphere3.Direction.AsVector := iNormal;
    Sphere3.Visible := True;
    Label1.Caption := 'Intersect!'
  end
  else
  begin
    Label1.Caption := 'No intersect!';
    Sphere3.Visible := False;
  end;
end;

procedure TMainForm.TrackBar2Change(Sender: TObject);
var
  RayStart, RayVector, iPoint, iNormal: TGLVector;
begin
  Sphere2.TurnAngle := TrackBar2.Position;
  if (FreeForm1.OcTreeRayCastIntersect(Sphere2.Position.AsVector,
    Sphere2.Direction.AsVector, @iPoint, @iNormal)) then
  begin
    Sphere3.Position.AsVector := iPoint;
    Sphere3.Direction.AsVector := iNormal;
    Sphere3.Visible := True;
    Label3.Caption := 'Intersect!'
  end
  else
  begin
    Label3.Caption := 'No intersect!';
    Sphere3.Visible := False;
  end;
end;

procedure TMainForm.TrackBar3Change(Sender: TObject);
begin
  FreeForm1.Position.X := TrackBar3.Position / 100
end;

procedure TMainForm.TrackBar4Change(Sender: TObject);
begin
  DummyCube.TurnAngle := TrackBar4.Position
end;

end.
